COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 patter.lsp[w84,jmc]	matching linear patterns
C00007 ENDMK
C⊗;
;;; patter.lsp[w84,jmc]	matching linear patterns
;;; (patter <list of variables with repetitions> <list of atoms>)
;;; => list of all matches, where a match pairs a variable with a sublist.
;;; (patter '(x y x) '(a b c a)) => (((x) (y a b c a)) ((x a) (y b c)))
;;; [Actually it seems to put  y  before  x  in this case.].

;;; We'll use difference lists.  A difference list is a pair of lists
;;; (u.v) where  v  is a tail of  u.  Difference lists are suitable
;;; for list matching, because they enable us to represent a sublist
;;; taken from the middle of a list without  CONSing up the elements.
;;; patter calls  p1  which calls  p2.  After getting the list of
;;; matches from  p1,  patter  gets rid of the difference lists in
;;; order to make the output easier to read.

(defun patter
       (pat  ; list of variables
	exp  ; list of atoms
	)
       (mapcar
	#'(lambda (v)
		  (mapcar
		   #'(lambda (u) (cons (car u) (diff (cadr u) (cddr u))))
		   v))
	(p1 pat exp nil nil)))

;;; the ordinary list represented by a difference list
;;; There is no provision for the error case that  v  isn't a tail of  u.
(defun diff (u v) (if (eq u v) nil (cons (car u) (diff (cdr u) v))))

(defun
 p1
 (pat ; tail of pattern
  exp ; tail of list being matched
  a   ; commitments so far made to variables
  lis ; list of matches found so far
  )
 (if (null pat)
     (if (null exp) (cons a lis) lis)
     (let ((z (assoc (car pat) a)))
	  (if (null z)
	      (p2 pat exp exp a lis)
	      (let ((w (end (cadr z) (cddr z) exp)))
		   (if (eq w 'lose)
		       lis
		       (p1 (cdr pat) w a lis)))))))
	  
(defun
 p2
 (pat ; tail of pattern
  exp ; tail of expression
  exp1; the current variable is to be matched against the difference of
;exp and exp1
  a   ; the current alist
  lis ; the matches found so far
  )
  (let ((zz (p1 (cdr pat) exp1 (cons (cons (car pat) (cons exp exp1)) a) lis)))
       (if (null exp1)
	   zz
	   (p2 pat exp (cdr exp1) a zz))))

(defun end (blis elis lis)
       (cond ((eq blis elis) lis)
	     ((or (null lis) (not (eq (car blis) (car lis)))) 'lose)
	     (t (end (cdr blis) elis (cdr lis)))))

;;; tests
(patter '(x y x) '(a b c a))
;(((Y B C) (X A)) ((Y A B C A) (X))) 
(patter '(x x) '(a b))
;NIL 
(patter '(x x) '(a b a b))
;(((X A B))) 
;; A variant that could do palindromes would be nice.

(patter '(x x y) '(a a b c))
;(((Y B C) (X A)) ((Y A A B C) (X))) 

(patter '(x x) '(a b a))
;NIL 

(patter '(x y z y x) '(r e f e r))
;(((Z F) (Y E) (X R)) ((Z E F E) (Y) (X R)) ((Z E F E) (Y R) (X)) ((Z R 
;E F E R) (Y) (X))) 

(setq t1 '(a b c d e))
;(A B C D E) 
(end t1 (cddr t1) '(c d e))
;LOSE 
(end t1 (cddr t1) '(a b d))
;(D) 
(p1 '(x) '(a b) nil nil)
;(((X (A B)))) 
(p1 '(x y x) '(a b c a) nil nil)
;(((Y (B C A) A) (X (A B C A) B C A)) ((Y (A B C A)) (X (A B C A) A B C 
A))) 

;;; clt rum version is in match.sli[rum,clt]
;;; and ex.rum[pfn,clt]
;;; proofs in match.x[rum,clt]
;;; and stream.sli[rum,clt]